home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #44 (May 89) / Forth Stuff / V5#5 SysEnvirons < prev   
Text File  |  1989-03-15  |  8KB  |  321 lines
  1. \ System configuration cdev 
  2. \ Example for MacTutor written in Mach2 Forth
  3. \ J.Langowski March 1989
  4.  
  5. only forth also mac also assembler
  6.  
  7. \ Define SysEnvirons trap; not present in Mach2.14 release
  8. \ alternatively, use the trap compiler accessible on the
  9. \ GEnie Mach2 libraries
  10.  
  11. .TRAP    _SysEnvirons    $A090
  12.  
  13. 0    CONSTANT    environsVersion
  14. 2    CONSTANT    machineType
  15. 4    CONSTANT    systemVersion
  16. 6    CONSTANT    processor
  17. 8    CONSTANT    hasFPU
  18. 9    CONSTANT    hasColorQD
  19. 10    CONSTANT    keyBoardType
  20. 12    CONSTANT    atDrvrVersNum
  21. 14    CONSTANT    sysVRefNum
  22.  
  23. \ compiler support words for kernel-independent definitions,
  24. \ defproc resources, etc.
  25. \ :xdef compiles a JMP at the beginning of the
  26. \ block, which is resolved at the end of the definition
  27. \ by ;xdef.
  28.  
  29. : :xdef ( -- branch marker )
  30.     create     -4 allot
  31.         $4EFA w, ( JMP )
  32.         0 w,     ( entry point to be filled later )
  33.         0 ,      ( length of routine to be filled later )
  34.         here 6 - 76543 ( marker for stack checking )
  35. ;
  36.  
  37. : ;xdef { branch marker entry | -- }
  38.     marker 76543 <> abort" xdef mismatch"
  39.     entry branch - branch w!
  40.     here branch - 2+ branch 2+ !
  41. ; 
  42.     
  43. : xlen 4 + @ ; ( get length word of external definition )
  44.  
  45. \ **** cdev proc glue macros for kernel-independent code
  46.  
  47. CODE cdev.prelude
  48.     LINK    A6,#-512         ( 512 bytes of local Forth stack )
  49.     MOVEM.L    A0-A5/D0-D7,-(A7)    ( save registers )
  50.     MOVE.L    A6,A3            ( setup local loop return stack )
  51.     SUBA.L    #256,A3            ( in the low 256 local stack bytes )
  52.     MOVE.L    8(A6),D0         ( CPDialog )
  53.     MOVE.L    12(A6),D1         ( cdevValue )
  54.     MOVE.L    16(A6),D2         ( theEvent )
  55.     CLR.L    D3
  56.     MOVE.W    20(A6),D3         ( CPanelID )
  57.     EXT.L    D3            ( in case this is negative )
  58.     CLR.L    D4
  59.     MOVE.W    22(A6),D4         ( numItems )
  60.     CLR.L    D5
  61.     MOVE.W    24(A6),D5         ( Item )
  62.     CLR.L    D6
  63.     MOVE.W    26(A6),D6         ( message )
  64.     MOVE.L    D6,-(A6)
  65.     MOVE.L    D5,-(A6)
  66.     MOVE.L    D4,-(A6)
  67.     MOVE.L    D3,-(A6)
  68.     MOVE.L    D2,-(A6)
  69.     MOVE.L    D1,-(A6)
  70.     MOVE.L    D0,-(A6)
  71.     RTS            \ just to indicate the MACHro stops here 
  72. END-CODE MACH
  73.  
  74. CODE cdev.epilogue ( resCode -- )
  75.     MOVE.L    (A6)+,D0
  76.     MOVE.L    D0,28(A6)        ( store function result )
  77.     MOVEM.L (A7)+,A0-A5/D0-D7    ( restore registers )
  78.     UNLK    A6
  79.     MOVE.L    (A7)+,A0        ( return address )
  80.     ADD.W    #20,A7            ( pop off 20 bytes of parameters )
  81.     JMP    (A0)
  82.     RTS
  83. END-CODE MACH
  84.  
  85. \ the actual cdev code starts here.
  86. \ REMEMBER: don't use CALL for the toolbox routines;
  87. \ use (CALL) instead, which is not dependent on D4 
  88. \ pointing to a correct stack.
  89.  
  90. :xdef myCdev
  91.  
  92. \ just to put some text into the resource
  93. \ for easier identification
  94.  
  95. : start " Mach2 Forth cdev example, JL/MacTutor 1989" ;
  96.  
  97. CODE SysEnvirons ( theWorld versrequested -- theWorld resCode )
  98.     MOVEA.L    4(A6),A0
  99.     MOVE.L    (A6)+,D0
  100.     ADDQ.L    #4,A6
  101.     _SysEnvirons
  102.     MOVE.L    A0,-(A6)
  103.     EXT.L    D0
  104.     MOVE.L    D0,-(A6)
  105.     RTS
  106. END-CODE
  107.  
  108. \ words which extract single items from the SysEnvRec
  109.  
  110. : ?mach { | [ 12 lallot ] sysEnvRec -- machine# }
  111.     ^ sysEnvRec 1 SysEnvirons drop 2+ w@ ;
  112.  
  113. : ?sys { | [ 12 lallot ] sysEnvRec -- system# revision# }
  114.     ^ sysEnvRec 1 SysEnvirons drop 
  115.         dup 5 + c@  swap 4+ c@ ;
  116.  
  117. : ?proc { | [ 12 lallot ] sysEnvRec -- machine# }
  118.     ^ sysEnvRec 1 SysEnvirons drop 6 + w@ ;
  119.  
  120. : ?fpu { | [ 12 lallot ] sysEnvRec -- machine# }
  121.     ^ sysEnvRec 1 SysEnvirons drop 8 + c@ ;
  122.  
  123. : ?colorQD { | [ 12 lallot ] sysEnvRec -- machine# }
  124.     ^ sysEnvRec 1 SysEnvirons drop 9 + c@ ;
  125.  
  126. : ?keyType { | [ 12 lallot ] sysEnvRec -- machine# }
  127.     ^ sysEnvRec 1 SysEnvirons drop 10 + w@ ;
  128.  
  129. : ?atkVers { | [ 12 lallot ] sysEnvRec -- machine# }
  130.     ^ sysEnvRec 1 SysEnvirons drop 12 + w@ ;
  131.  
  132. : ?sysVRef { | [ 12 lallot ] sysEnvRec -- machine# }
  133.     ^ sysEnvRec 1 SysEnvirons drop 14 + w@ l_ext ;
  134.  
  135. \ factored out the GetDItem/SetIText stuff
  136.  
  137. : set.item ( string dlgPtr #item ) { | type hItem box -- }
  138.     ^ type ^ hItem ^ box (call) GetDItem
  139.     hItem swap (call) SetIText ;
  140.  
  141. \ display system characteristics 
  142. \ in the cdev dialog box (DITL -4064 resource dependent)
  143. \ the strings are hard-coded, but could as well be contained 
  144. \ in a STR# resource
  145.  
  146. : display.it {  numItems dlgPtr | [ 16 lallot ] str1 -- }
  147.     ?mach CASE 
  148.         0 OF " unknown" ENDOF
  149.         1 OF " Mac 512KE" ENDOF
  150.         2 OF " Mac Plus" ENDOF
  151.         3 OF " Mac SE" ENDOF
  152.         4 OF " Mac II" ENDOF
  153.         5 OF " Mac IIx" ENDOF
  154.     \ wasn't sure whether machine=6 is the new baby MacII,
  155.     \ so left out that case
  156.         7 OF " Mac SE/030" ENDOF
  157.         " NEW MACHINE"
  158.     ENDCASE     dlgPtr 3 numItems + set.item
  159.  
  160.     \ get system version # and convert to string, format X.XX 
  161.     \ if you don't know Forth, this might be hard to read :-)
  162.     ?sys 
  163.         ^ str1 swap (call) numtostring 
  164.         dup c@ 1+ + swap (call) numtostring 
  165.         dup c@ 1 = IF dup 1+ c@ over 2+ c! 
  166.                     dup 1+ ascii 0 swap c! THEN
  167.         ascii . swap c!  
  168.         ^ str1 dup c@ 3 + swap c!
  169.     ^ str1 dlgPtr 5 numItems + set.item 
  170.  
  171.     ?proc CASE
  172.         0 OF " unknown" ENDOF
  173.         1 OF " 68000" ENDOF
  174.         2 OF " 68010" ENDOF
  175.         3 OF " 68020" ENDOF
  176.         4 OF " 68030" ENDOF
  177.         " NEW"
  178.     ENDCASE dlgPtr 7 numItems + set.item
  179.  
  180.     ?fpu IF " yes" ELSE " none" THEN
  181.         dlgPtr 9 numItems + set.item 
  182.  
  183.     ?colorQD IF " yes" ELSE " no" THEN
  184.         dlgPtr 11 numItems + set.item 
  185.  
  186.     ?keyType CASE 
  187.         0 OF " unknown type" ENDOF
  188.         1 OF " 'old' Macintosh keyboard" ENDOF
  189.         2 OF " 'old' Macintosh keyboard with keypad" ENDOF
  190.         3 OF " Macintosh Plus keyboard" ENDOF
  191.         4 OF " Apple Desktop Bus extended keyboard" ENDOF
  192.         5 OF " Apple Desktop Bus standard keyboard" ENDOF
  193.         " something NEW" 
  194.     ENDCASE dlgPtr 13 numItems + set.item 
  195.  
  196.     ^ str1 ?atkVers (call) numtostring
  197.         dlgPtr 15 numItems + set.item 
  198. ;
  199.     
  200. : testCdev { message item numItems CPanelID
  201.              theEvent cdevValue CPDialog -- result }
  202.     \ we only need to respond to the initDev message
  203.     \ by putting the system configuration info
  204.     \ into the cdev's dialog items
  205.     message CASE
  206.         0 OF ( initDev ) 1 (call) sysbeep 
  207.             numItems CPDialog display.it ENDOF
  208.         ( insert handlers for other messages here)
  209.     ENDCASE
  210.     cdevValue \ everything OK: return old cdevValue
  211. ;
  212.  
  213. : cdev.glue 
  214.     cdev.prelude
  215.     testCdev
  216.     cdev.epilogue
  217. ;
  218.  
  219. ' cdev.glue ;xdef
  220.  
  221. \ end of cdev code
  222.  
  223.  
  224. \ making the cdev resource, the usual way
  225.  
  226. : $create-res call CreateResFile call ResError L_ext ;
  227.  
  228. : $open-res { addr | refNum -- result }
  229.     addr call openresfile -> refNum
  230.     call ResError L_ext
  231.     dup not IF drop refNum THEN 
  232. ;
  233.  
  234. : $close-res call CloseResFile call ResError L_ext ;
  235.  
  236. : make-cdev { | refNum -- }
  237.     " cdev.res" dup $create-res
  238.     abort" You have to delete the old 'cdev.res' file first."
  239.     $open-res dup -> refNum call UseResFile 
  240.     ['] myCdev dup xlen
  241.         call PtrToHand drop ( result code )
  242.         ASCII cdev -4064 " cdev JL" call AddResource
  243.     refNum $close-res drop ( result code )
  244. ;
  245.  
  246. \ End of cdev creation code.
  247. \ Following are some words that can be executed 
  248. \ from within the Mach2 system, and output system configuration
  249. \ information directly to the console.
  250.      
  251. : myMachine cr ." This is a"
  252.     ?mach CASE
  253.         0 OF ." n unknown machine," ENDOF
  254.         1 OF ."  Mac 512KE," ENDOF
  255.         2 OF ."  Mac Plus," ENDOF
  256.         3 OF ."  Mac SE," ENDOF
  257.         4 OF ."  Mac II," ENDOF
  258.         5 OF ."  Mac IIx," ENDOF
  259.         7 OF ."  Mac SE/030," ENDOF
  260.         ."  NEW MACHINE,"
  261.     ENDCASE
  262. ;
  263.  
  264.  
  265. : mySystem ?sys
  266.     ."  running system v. " 
  267.     <# # #> type ascii . emit 
  268.     <# # # #> type ascii . emit
  269. ;
  270.  
  271. : myProcessor cr ." It uses a"
  272.     ?proc CASE
  273.         0 OF ." n unknown" ENDOF
  274.         1 OF ."  68000" ENDOF
  275.         2 OF ."  68010" ENDOF
  276.         3 OF ."  68020" ENDOF
  277.         4 OF ."  68030" ENDOF
  278.         ."  NEW"
  279.     ENDCASE
  280.     ."  processor"
  281. ;
  282.  
  283. : myFPU ?fpu IF
  284.       ascii , emit cr 
  285.       ." and has an arithmetic coprocessor installed." 
  286.     ELSE
  287.       ascii . emit
  288.     THEN
  289. ;
  290.  
  291. : myCQD cr ." Color QuickDraw is "
  292.     ?colorQD 0= IF ." not " THEN
  293.     ." available."
  294. ;
  295.  
  296. : myKeyBoard cr ." The Keyboard is "
  297.     ?keyType CASE 
  298.         0 OF ." of an unknown type." ENDOF
  299.         1 OF ." the 'old' Macintosh type." ENDOF
  300.         2 OF ." the 'old' Macintosh type with keypad." ENDOF
  301.         3 OF ." the Mac Plus type." ENDOF
  302.         4 OF ." the ADB extended type." ENDOF
  303.         5 OF ." the standard ADB type." ENDOF
  304.         ." a NEW type." 
  305.     ENDCASE
  306. ;
  307.  
  308. : myAtkDrvr cr ." Appletalk v. " ?atkVers . 
  309.     ." is installed."
  310. ;
  311.  
  312. : machTest 
  313.     myMachine mySystem 
  314.     myProcessor myFPU
  315.     myCQD
  316.     myKeyBoard
  317.     myAtkDrvr
  318.     cr
  319. ;
  320.  
  321.